home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / misc_pto / 899 / 899gpred.pro < prev    next >
Text File  |  1990-03-30  |  7KB  |  251 lines
  1. project "899"
  2. include "899glob.pro"
  3.  
  4. % 899GPRED.PRO -- Global Miscelaneous Predicate-clauses
  5. % GLOBAL PREDICATES IN THIS FILE::
  6. %        getMusicTypes
  7. %        getLabelNames
  8. %        repeat
  9. %        getIntOpt
  10. %        showerr
  11. %        message
  12. %        askyn
  13. %        bep
  14. %        inverse
  15. %        wait
  16. %        up_case
  17. %        readKey
  18. %        getKey
  19. %        change_window_title
  20. %        getCorrelating
  21. %        listlen
  22. %        maxlen
  23. %        modifdat
  24. %        expgsList
  25. %        sameMusicCategory
  26. %        writeToEol
  27. %        writelist
  28. %        writespaces
  29.  
  30. DATABASE - correlator
  31.   determ namelist(gsList)
  32.  
  33. PREDICATES
  34.   key_code(key,CHAR,INTEGER)
  35.   key_code2(key,INTEGER)
  36.   memberK(key,keylist)
  37.   gtIntC2(INTEGER,INTEGER,INTEGER,INTEGER,INTEGER)
  38.   wel(INTEGER,INTEGER,CHAR)
  39.   stopwatch(INTEGER)
  40.   cnt(INTEGER,INTEGER,INTEGER)
  41.   match(gs)      % Used by correlator
  42.   str_split(STRING,gsList,gsList,gsList)
  43.   str_add(gsList,gsList,gsList)
  44.  
  45. CLAUSES
  46.   repeat.
  47.   repeat :- repeat.
  48.   
  49.   getMusicTypes(CurrentlyDefinedMusicTypes) :-
  50.       findall(Music,category(Music),CurrentlyDefinedMusicTypes).
  51.  
  52.   getLabelNames(FullListOfNames) :-
  53.       findall(Nms,label(_,Nms,_,_,_,_,_,_),FullListOfNames).
  54.  
  55.   wait :- write("Press Enter to Continue\n"),
  56.           getkey(_,[cr]).
  57.  
  58. /*
  59.   memgsList(H,[H|_]) :- !.
  60.   memgsList(H,[_|T]) :- memgsList(H,T).
  61.  
  62.   up_case(InChar,Outchar) :-
  63.     str_char(InString,InChar),
  64.     upper_lower(InStrUp,InString),
  65.     str_char(InStrUp,OutChar).
  66. */
  67.  
  68.   getkey(Retkey,ValidList) :-  /* We do fun things */
  69.     getbacktrack(Btop),
  70.     repeat,                    /* do the follwing */
  71.       readkey(K),              /* 1) get a keypress and see what it is */
  72.       memberK(K,ValidList), !, /* 2) see if it is in the list of valid keys */
  73.     cutbacktrack(Btop),
  74.     Retkey=K.                  /* If so, then return the key otherwise above will loop */
  75.  
  76.   memberK(Object,[Object|_]) :- !.                   /* Memer of key if is the head */
  77.   memberK(Object,[_|Tail]) :- memberK(Object,Tail).  /* Or in the tail */
  78.  
  79.   sameMusicCategory(SomeType,[SomeType|_]) :- !.
  80.   sameMusicCategory(SomeType,[_|RestOfList]) :- sameMusicCategory(SomeType,RestOfList).
  81.  
  82.   readkey(K):- readchar(T), char_int(T,Val), key_code(K,T,Val).
  83.  
  84.   key_code(K,_,0):- readchar(T), char_int(T,Val), key_code2(K,Val),!.
  85.   key_code(break,_,3)  :-!.     key_code(bdel,_,8):-!.
  86.   key_code(tab,_,10)   :-!.     key_code(cr,_,13) :-!.
  87.   key_code(esc,_,27)   :-!.
  88.   key_code(num(N),_,S) :-S>=$30, S<=$39, N=S-$30, !.
  89.   key_code(char(T),T,_).
  90.   
  91.   key_code2(btab,15)   :-!.     key_code2(home,71):-!.
  92.   key_code2(up,72)     :-!.     key_code2(left,75):-!.
  93.   key_code2(right,77)  :-!.     key_code2(end,79) :-!.
  94.   key_code2(down,80)   :-!.     key_code2(ins,82) :-!.
  95.   key_code2(del,83)    :-!.     key_code2(pgup,73):-!.
  96.   key_code2(pgdn,81)   :-!.
  97.   key_code2(fkey(N),V) :-V>58, V<70, N=V-58, !.
  98.   key_code2(other,_).
  99.  
  100.   change_window_title(NewTitle) :- % Changes the title on currently active window
  101.     makewindow(_,_,FrameAtt,_,_,_,_,_,_,Placement,BorderDef), % Get some of this
  102.     framewindow(FrameAtt,NewTitle,PlaceMent,BorderDef).
  103.  
  104. /*
  105.   inverse(A1,A2):-
  106.     bitand(A1,$07,H11),
  107.     bitleft(H11,4,H12),
  108.     bitand(A1,$70,H21),
  109.     bitright(H21,4,H22),
  110.     bitand(A1,$08,H31),
  111.     A2=H12+H22+H31.
  112. */
  113.  
  114.   getIntOpt(Min,Max,Choice) :-
  115.     getbacktrack(Btop),
  116.     write("Please choose an option (",Min,'-',Max,") --> "),
  117.     cursor(CurrX,CurrY), % Get coords
  118.     repeat,
  119.       cursor(CurrX,CurrY),
  120.       writeToEol(' '),
  121.       cursor(CurrX,CurrY),
  122.       readint(X),
  123.       cursor(CurrX,CurrY),
  124.     gtIntC2(Min,Max,X,CurrX,CurrY),
  125.     cutbacktrack(Btop),
  126.     Choice = X.
  127.  
  128.   gtIntC2(Min,Max,X,_,_) :-
  129.     X >= Min, X <= Max, !.
  130.   gtIntC2(_,_,_,CurrX,CurrY) :-
  131.     cursor(CurrX,CurrY),
  132.     writeToEol(' '),
  133.     fail.
  134.  
  135.   writeToEol(DataChar) :-
  136.     makewindow(_,_,_,_,_,_,_,MaxY),
  137.     LastPlace = MaxY - 2,
  138.     cursor(CurrX,CurrY),
  139.     getbacktrack(Btop),
  140.     wel(CurrY,LastPlace,DataChar),
  141.     cutbacktrack(Btop),
  142.     cursor(CurrX,CurrY).
  143.  
  144.   wel(X,X,Q) :- !, write(Q).
  145.   wel(C,M,D) :- write(D), Nn = C + 1, wel(Nn,M,D).
  146.  
  147.   showerr(Ps) :-
  148.     makewindow(105,79,0,"",22,0,2,80),
  149.     write(Ps), nl,
  150.     wait,
  151.     removewindow.
  152.  
  153.   message(Ps) :-
  154.     Attr = b_blue + yellow,
  155.     makewindow(105,Attr,0,"",22,0,2,80),
  156.     write(Ps),
  157.     stopwatch(100),
  158.     removewindow.
  159.  
  160.   stopwatch(TimeDelay) :-
  161.     cnt(TimeDelay,1000,0).
  162.   
  163.   cnt(0,1000,1000) :- !.
  164.   cnt(X,N,N) :- !, NewX = X - 1, cnt(NewX,1000,0).
  165.   cnt(X,N,F) :- NewF = F + 1, cnt(X,N,NewF).
  166.  
  167.   askyn :-    /* Get's user's reponse (Y/N) and fails on anything except Y or y */
  168.       readln(Response),
  169.       frontchar(Response,RsChar,_),
  170.       upchar(RsChar,UsrChar),
  171.       UsrChar = 'Y', !.
  172.  
  173.   bep :- sound(5,1300), sound(10,300), sound(15,165).
  174.  
  175.   getCorrelating(SomeGivenMusicType,ListOfQualifiedNames) :-
  176.       getbacktrack(Btop),
  177.       assert(namelist([]),correlator),
  178.       match(SomeGivenMusicType),
  179.       retract(namelist(ListOfQualifiedNames),correlator),
  180.       cutbacktrack(Btop).
  181.   
  182.   match(GivenMusicType) :-
  183.       label(TypesForThisContact,ContactName,_,_,_,_,_,_),
  184.         getbacktrack(Btop),
  185.         sameMusicCategory(GivenMusicType,TypesForThisContact), % If this succeds
  186.         retract(namelist(CurrList),correlator),
  187.         NewList = [ContactName | CurrList],
  188.         assert(namelist(NewList),correlator),
  189.         cutbacktrack(Btop),
  190.       fail.
  191.   match(_).
  192.  
  193. /*
  194.   maxlen([H|T],MAX,MAX1) :-
  195.     str_len(H,LENGTH),
  196.     LENGTH>MAX,!,
  197.     maxlen(T,LENGTH,MAX1).
  198.   maxlen([_|T],MAX,MAX1) :- maxlen(T,MAX,MAX1).
  199.   maxlen([],LENGTH,LENGTH).
  200.  
  201.   listlen([],0).
  202.   listlen([_|T],N):-
  203.     listlen(T,X),
  204.     N=X+1.
  205.  
  206.   expgsList(TargetDelete,[TargetDelete|RestOfList],RestOfList) :- !.
  207.   expgsList(TargetDelete,[ItemBeforeDeletedItem|RestOfList],NewList) :-
  208.     expgsList(TargetDelete,RestOfList,ListOfItemsAfterDeletedItem),
  209.     NewList = [ItemBeforeDeletedItem | ListOfItemsAfterDeletedItem]. % Exclude deleted item
  210. */
  211.  
  212.   modifdat :-
  213.       retract(datamodified),
  214.       fail.
  215.   modifdat :-
  216.       assert(datamodified).
  217.  
  218.   writespaces(0) :- !.
  219.   writespaces(N) :- write(' '), Nn = N - 1, writespaces(Nn).
  220.  
  221.   writelist([],_) :- !.
  222.   writelist([Curr|Next],IndentFactor) :-
  223.       Curr <> "", !,
  224.       writespaces(Indentfactor),
  225.       write(Curr), nl,
  226.       writelist(Next,IndentFactor).
  227.   writelist([_|Next],IndentFactor) :- writelist(Next,IndentFactor).  % Skip Null strings
  228.  
  229.   str_add([],X,X).
  230.   str_add([H|L],L1,[H|L2]) :-
  231.       str_add(L,L1,L2).
  232.  
  233.   str_split(_,[],[],[]).
  234.   str_split(H,[A|X],[A|Y],Z) :-
  235.       A > H, !,
  236.       str_split(H,X,Y,Z).
  237.   str_split(H,[A|X],Y,[A|Z]) :-
  238.       A <= H, !,
  239.       str_split(H,X,Y,Z).
  240.  
  241.   str_qsort([],[]).
  242.   str_qsort([H|T],S) :-
  243.       str_split(H,T,A,B),
  244.       str_qsort(A,A1),
  245.       str_qsort(B,B1),
  246.       str_add(A1,[H|B1],S).
  247.  
  248.   uniqueS([],[]).
  249.   uniqueS([H|T],L) :- memgsList(H,T), !, uniqueS(T,L).
  250.   uniqueS([H|T],[H|L]) :- uniqueS(T,L).
  251.